home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / gfx / misc / gnuplot-3.7src.lha / gnuplot-3.7src / gnuplot-3.7.lha / gnuplot-3.7 / internal.c < prev    next >
C/C++ Source or Header  |  1998-12-08  |  20KB  |  982 lines
  1. #ifndef lint
  2. static char *RCSid = "$Id: internal.c,v 1.23 1998/04/14 00:15:44 drd Exp $";
  3. #endif
  4.  
  5. /* GNUPLOT - internal.c */
  6.  
  7. /*[
  8.  * Copyright 1986 - 1993, 1998   Thomas Williams, Colin Kelley
  9.  *
  10.  * Permission to use, copy, and distribute this software and its
  11.  * documentation for any purpose with or without fee is hereby granted,
  12.  * provided that the above copyright notice appear in all copies and
  13.  * that both that copyright notice and this permission notice appear
  14.  * in supporting documentation.
  15.  *
  16.  * Permission to modify the software is granted, but not the right to
  17.  * distribute the complete modified source code.  Modifications are to
  18.  * be distributed as patches to the released version.  Permission to
  19.  * distribute binaries produced by compiling modified sources is granted,
  20.  * provided you
  21.  *   1. distribute the corresponding source modifications from the
  22.  *    released version in the form of a patch file along with the binaries,
  23.  *   2. add special version identification to distinguish your version
  24.  *    in addition to the base release version number,
  25.  *   3. provide your name and address as the primary contact for the
  26.  *    support of your modified version, and
  27.  *   4. retain our contact information in regard to use of the base
  28.  *    software.
  29.  * Permission to distribute the released version of the source code along
  30.  * with corresponding source modifications in the form of a patch file is
  31.  * granted with same provisions 2 through 4 for binary distributions.
  32.  *
  33.  * This software is provided "as is" without express or implied warranty
  34.  * to the extent permitted by applicable law.
  35. ]*/
  36.  
  37.  
  38. #include "plot.h"
  39. #include "fnproto.h"
  40.  
  41. /* some machines have trouble with exp(-x) for large x
  42.  * if MINEXP is defined at compile time, use gp_exp(x) instead,
  43.  * which returns 0 for exp(x) with x < MINEXP
  44.  * exp(x) will already have been defined as gp_exp(x) in plot.h
  45.  */
  46.  
  47. #ifdef MINEXP
  48. double gp_exp(x)
  49. double x;
  50. {
  51.     return (x < (MINEXP)) ? 0.0 : exp(x);
  52. }
  53. #endif
  54.  
  55. TBOOLEAN undefined;
  56.  
  57. static void int_check __PROTO((struct value * v));
  58.  
  59. struct value stack[STACK_DEPTH];
  60.  
  61. int s_p = -1;            /* stack pointer */
  62.  
  63.  
  64. /*
  65.  * System V and MSC 4.0 call this when they wants to print an error message.
  66.  * Don't!
  67.  */
  68. #ifndef _CRAY
  69. # ifdef AMIGA_SC_6_1
  70. #  define matherr __matherr
  71. #  define exception __exception
  72. # endif                /* AMIGA_SC_6_1 */
  73. # if defined(__BORLANDC__) && __BORLANDC__ >= 0x450
  74. #  define matherr _matherr
  75. # endif                /* __BORLANDC__ >= 0x450 */
  76. # if (defined(MSDOS) || defined(DOS386)) && defined(__TURBOC__) || defined(VMS)
  77. int matherr()
  78. #else
  79. int matherr(x)
  80. struct exception *x;
  81. # endif                /* (MSDOS || DOS386) && __TURBOC__ */
  82. {
  83.     return (undefined = TRUE);    /* don't print error message */
  84. }
  85. #endif /* not _CRAY */
  86.  
  87.  
  88. void reset_stack()
  89. {
  90.     s_p = -1;
  91. }
  92.  
  93.  
  94. void check_stack()
  95. {                /* make sure stack's empty */
  96.     if (s_p != -1)
  97.     fprintf(stderr, "\n\
  98. warning:  internal error--stack not empty!\n\
  99.           (function called with too many parameters?)\n");
  100. }
  101.  
  102. #define BAD_DEFAULT default: int_error("interal error : type neither INT or CMPLX", NO_CARET); return;
  103.  
  104. struct value *pop(x)
  105. struct value *x;
  106. {
  107.     if (s_p < 0)
  108.     int_error("stack underflow (function call with missing parameters?)", NO_CARET);
  109.     *x = stack[s_p--];
  110.     return (x);
  111. }
  112.  
  113.  
  114. void push(x)
  115. struct value *x;
  116. {
  117.     if (s_p == STACK_DEPTH - 1)
  118.     int_error("stack overflow", NO_CARET);
  119.     stack[++s_p] = *x;
  120. }
  121.  
  122.  
  123. #define ERR_VAR "undefined variable: "
  124.  
  125. void f_push(x)
  126. union argument *x;        /* contains pointer to value to push; */
  127. {
  128.     static char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR;
  129.     struct udvt_entry *udv;
  130.  
  131.     udv = x->udv_arg;
  132.     if (udv->udv_undef) {    /* undefined */
  133.     (void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name);
  134.     int_error(err_str, NO_CARET);
  135.     }
  136.     push(&(udv->udv_value));
  137. }
  138.  
  139.  
  140. void f_pushc(x)
  141. union argument *x;
  142. {
  143.     push(&(x->v_arg));
  144. }
  145.  
  146.  
  147. void f_pushd1(x)
  148. union argument *x;
  149. {
  150.     push(&(x->udf_arg->dummy_values[0]));
  151. }
  152.  
  153.  
  154. void f_pushd2(x)
  155. union argument *x;
  156. {
  157.     push(&(x->udf_arg->dummy_values[1]));
  158. }
  159.  
  160.  
  161. void f_pushd(x)
  162. union argument *x;
  163. {
  164.     struct value param;
  165.     (void) pop(¶m);
  166.     push(&(x->udf_arg->dummy_values[param.v.int_val]));
  167. }
  168.  
  169.  
  170. #define ERR_FUN "undefined function: "
  171.  
  172. void f_call(x)            /* execute a udf */
  173. union argument *x;
  174. {
  175.     static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
  176.     register struct udft_entry *udf;
  177.     struct value save_dummy;
  178.  
  179.     udf = x->udf_arg;
  180.     if (!udf->at) {        /* undefined */
  181.     (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
  182.               udf->udf_name);
  183.     int_error(err_str, NO_CARET);
  184.     }
  185.     save_dummy = udf->dummy_values[0];
  186.     (void) pop(&(udf->dummy_values[0]));
  187.  
  188.     execute_at(udf->at);
  189.     udf->dummy_values[0] = save_dummy;
  190. }
  191.  
  192.  
  193. void f_calln(x)            /* execute a udf of n variables */
  194. union argument *x;
  195. {
  196.     static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
  197.     register struct udft_entry *udf;
  198.     struct value save_dummy[MAX_NUM_VAR];
  199.  
  200.     int i;
  201.     int num_pop;
  202.     struct value num_params;
  203.  
  204.     udf = x->udf_arg;
  205.     if (!udf->at) {        /* undefined */
  206.     (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
  207.               udf->udf_name);
  208.     int_error(err_str, NO_CARET);
  209.     }
  210.     for (i = 0; i < MAX_NUM_VAR; i++)
  211.     save_dummy[i] = udf->dummy_values[i];
  212.  
  213.     /* if there are more parameters than the function is expecting */
  214.     /* simply ignore the excess */
  215.     (void) pop(&num_params);
  216.  
  217.     if (num_params.v.int_val > MAX_NUM_VAR) {
  218.     /* pop the dummies that there is no room for */
  219.     num_pop = num_params.v.int_val - MAX_NUM_VAR;
  220.     for (i = 0; i < num_pop; i++)
  221.         (void) pop(&(udf->dummy_values[i]));
  222.  
  223.     num_pop = MAX_NUM_VAR;
  224.     } else {
  225.     num_pop = num_params.v.int_val;
  226.     }
  227.  
  228.     /* pop parameters we can use */
  229.     for (i = num_pop - 1; i >= 0; i--)
  230.     (void) pop(&(udf->dummy_values[i]));
  231.  
  232.     execute_at(udf->at);
  233.     for (i = 0; i < MAX_NUM_VAR; i++)
  234.     udf->dummy_values[i] = save_dummy[i];
  235. }
  236.  
  237.  
  238. static void int_check(v)
  239. struct value *v;
  240. {
  241.     if (v->type != INTGR)
  242.     int_error("non-integer passed to boolean operator", NO_CARET);
  243. }
  244.  
  245.  
  246. void f_lnot()
  247. {
  248.     struct value a;
  249.     int_check(pop(&a));
  250.     push(Ginteger(&a, !a.v.int_val));
  251. }
  252.  
  253.  
  254. void f_bnot()
  255. {
  256.     struct value a;
  257.     int_check(pop(&a));
  258.     push(Ginteger(&a, ~a.v.int_val));
  259. }
  260.  
  261.  
  262. void f_bool()
  263. {                /* converts top-of-stack to boolean */
  264.     int_check(&top_of_stack);
  265.     top_of_stack.v.int_val = !!top_of_stack.v.int_val;
  266. }
  267.  
  268.  
  269. void f_lor()
  270. {
  271.     struct value a, b;
  272.     int_check(pop(&b));
  273.     int_check(pop(&a));
  274.     push(Ginteger(&a, a.v.int_val || b.v.int_val));
  275. }
  276.  
  277. void f_land()
  278. {
  279.     struct value a, b;
  280.     int_check(pop(&b));
  281.     int_check(pop(&a));
  282.     push(Ginteger(&a, a.v.int_val && b.v.int_val));
  283. }
  284.  
  285.  
  286. void f_bor()
  287. {
  288.     struct value a, b;
  289.     int_check(pop(&b));
  290.     int_check(pop(&a));
  291.     push(Ginteger(&a, a.v.int_val | b.v.int_val));
  292. }
  293.  
  294.  
  295. void f_xor()
  296. {
  297.     struct value a, b;
  298.     int_check(pop(&b));
  299.     int_check(pop(&a));
  300.     push(Ginteger(&a, a.v.int_val ^ b.v.int_val));
  301. }
  302.  
  303.  
  304. void f_band()
  305. {
  306.     struct value a, b;
  307.     int_check(pop(&b));
  308.     int_check(pop(&a));
  309.     push(Ginteger(&a, a.v.int_val & b.v.int_val));
  310. }
  311.  
  312.  
  313. void f_uminus()
  314. {
  315.     struct value a;
  316.     (void) pop(&a);
  317.     switch (a.type) {
  318.     case INTGR:
  319.     a.v.int_val = -a.v.int_val;
  320.     break;
  321.     case CMPLX:
  322.     a.v.cmplx_val.real =
  323.         -a.v.cmplx_val.real;
  324.     a.v.cmplx_val.imag =
  325.         -a.v.cmplx_val.imag;
  326.     break;
  327.     BAD_DEFAULT
  328.     }
  329.     push(&a);
  330. }
  331.  
  332.  
  333. void f_eq()
  334. {
  335.     /* note: floating point equality is rare because of roundoff error! */
  336.     struct value a, b;
  337.     register int result = 0;
  338.     (void) pop(&b);
  339.     (void) pop(&a);
  340.     switch (a.type) {
  341.     case INTGR:
  342.     switch (b.type) {
  343.     case INTGR:
  344.         result = (a.v.int_val ==
  345.               b.v.int_val);
  346.         break;
  347.     case CMPLX:
  348.         result = (a.v.int_val ==
  349.               b.v.cmplx_val.real &&
  350.               b.v.cmplx_val.imag == 0.0);
  351.         break;
  352.         BAD_DEFAULT
  353.     }
  354.     break;
  355.     case CMPLX:
  356.     switch (b.type) {
  357.     case INTGR:
  358.         result = (b.v.int_val == a.v.cmplx_val.real &&
  359.               a.v.cmplx_val.imag == 0.0);
  360.         break;
  361.     case CMPLX:
  362.         result = (a.v.cmplx_val.real ==
  363.               b.v.cmplx_val.real &&
  364.               a.v.cmplx_val.imag ==
  365.               b.v.cmplx_val.imag);
  366.         break;
  367.         BAD_DEFAULT
  368.     }
  369.     break;
  370.     BAD_DEFAULT
  371.     }
  372.     push(Ginteger(&a, result));
  373. }
  374.  
  375.  
  376. void f_ne()
  377. {
  378.     struct value a, b;
  379.     register int result = 0;
  380.     (void) pop(&b);
  381.     (void) pop(&a);
  382.     switch (a.type) {
  383.     case INTGR:
  384.     switch (b.type) {
  385.     case INTGR:
  386.         result = (a.v.int_val !=
  387.               b.v.int_val);
  388.         break;
  389.     case CMPLX:
  390.         result = (a.v.int_val !=
  391.               b.v.cmplx_val.real ||
  392.               b.v.cmplx_val.imag != 0.0);
  393.         break;
  394.         BAD_DEFAULT
  395.     }
  396.     break;
  397.     case CMPLX:
  398.     switch (b.type) {
  399.     case INTGR:
  400.         result = (b.v.int_val !=
  401.               a.v.cmplx_val.real ||
  402.               a.v.cmplx_val.imag != 0.0);
  403.         break;
  404.     case CMPLX:
  405.         result = (a.v.cmplx_val.real !=
  406.               b.v.cmplx_val.real ||
  407.               a.v.cmplx_val.imag !=
  408.               b.v.cmplx_val.imag);
  409.         break;
  410.         BAD_DEFAULT
  411.     }
  412.     break;
  413.     BAD_DEFAULT
  414.     }
  415.     push(Ginteger(&a, result));
  416. }
  417.  
  418.  
  419. void f_gt()
  420. {
  421.     struct value a, b;
  422.     register int result = 0;
  423.     (void) pop(&b);
  424.     (void) pop(&a);
  425.     switch (a.type) {
  426.     case INTGR:
  427.     switch (b.type) {
  428.     case INTGR:
  429.         result = (a.v.int_val >
  430.               b.v.int_val);
  431.         break;
  432.     case CMPLX:
  433.         result = (a.v.int_val >
  434.               b.v.cmplx_val.real);
  435.         break;
  436.         BAD_DEFAULT
  437.     }
  438.     break;
  439.     case CMPLX:
  440.     switch (b.type) {
  441.     case INTGR:
  442.         result = (a.v.cmplx_val.real >
  443.               b.v.int_val);
  444.         break;
  445.     case CMPLX:
  446.         result = (a.v.cmplx_val.real >
  447.               b.v.cmplx_val.real);
  448.         break;
  449.         BAD_DEFAULT
  450.     }
  451.     break;
  452.     BAD_DEFAULT
  453.     }
  454.     push(Ginteger(&a, result));
  455. }
  456.  
  457.  
  458. void f_lt()
  459. {
  460.     struct value a, b;
  461.     register int result = 0;
  462.     (void) pop(&b);
  463.     (void) pop(&a);
  464.     switch (a.type) {
  465.     case INTGR:
  466.     switch (b.type) {
  467.     case INTGR:
  468.         result = (a.v.int_val <
  469.               b.v.int_val);
  470.         break;
  471.     case CMPLX:
  472.         result = (a.v.int_val <
  473.               b.v.cmplx_val.real);
  474.         break;
  475.         BAD_DEFAULT
  476.     }
  477.     break;
  478.     case CMPLX:
  479.     switch (b.type) {
  480.     case INTGR:
  481.         result = (a.v.cmplx_val.real <
  482.               b.v.int_val);
  483.         break;
  484.     case CMPLX:
  485.         result = (a.v.cmplx_val.real <
  486.               b.v.cmplx_val.real);
  487.         break;
  488.         BAD_DEFAULT
  489.     }
  490.     break;
  491.     BAD_DEFAULT
  492.     }
  493.     push(Ginteger(&a, result));
  494. }
  495.  
  496.  
  497. void f_ge()
  498. {
  499.     struct value a, b;
  500.     register int result = 0;
  501.     (void) pop(&b);
  502.     (void) pop(&a);
  503.     switch (a.type) {
  504.     case INTGR:
  505.     switch (b.type) {
  506.     case INTGR:
  507.         result = (a.v.int_val >=
  508.               b.v.int_val);
  509.         break;
  510.     case CMPLX:
  511.         result = (a.v.int_val >=
  512.               b.v.cmplx_val.real);
  513.         break;
  514.         BAD_DEFAULT
  515.     }
  516.     break;
  517.     case CMPLX:
  518.     switch (b.type) {
  519.     case INTGR:
  520.         result = (a.v.cmplx_val.real >=
  521.               b.v.int_val);
  522.         break;
  523.     case CMPLX:
  524.         result = (a.v.cmplx_val.real >=
  525.               b.v.cmplx_val.real);
  526.         break;
  527.         BAD_DEFAULT
  528.     }
  529.     break;
  530.     BAD_DEFAULT
  531.     }
  532.     push(Ginteger(&a, result));
  533. }
  534.  
  535.  
  536. void f_le()
  537. {
  538.     struct value a, b;
  539.     register int result = 0;
  540.     (void) pop(&b);
  541.     (void) pop(&a);
  542.     switch (a.type) {
  543.     case INTGR:
  544.     switch (b.type) {
  545.     case INTGR:
  546.         result = (a.v.int_val <=
  547.               b.v.int_val);
  548.         break;
  549.     case CMPLX:
  550.         result = (a.v.int_val <=
  551.               b.v.cmplx_val.real);
  552.         break;
  553.         BAD_DEFAULT
  554.     }
  555.     break;
  556.     case CMPLX:
  557.     switch (b.type) {
  558.     case INTGR:
  559.         result = (a.v.cmplx_val.real <=
  560.               b.v.int_val);
  561.         break;
  562.     case CMPLX:
  563.         result = (a.v.cmplx_val.real <=
  564.               b.v.cmplx_val.real);
  565.         break;
  566.         BAD_DEFAULT
  567.     }
  568.     break;
  569.     BAD_DEFAULT
  570.     }
  571.     push(Ginteger(&a, result));
  572. }
  573.  
  574.  
  575. void f_plus()
  576. {
  577.     struct value a, b, result;
  578.     (void) pop(&b);
  579.     (void) pop(&a);
  580.     switch (a.type) {
  581.     case INTGR:
  582.     switch (b.type) {
  583.     case INTGR:
  584.         (void) Ginteger(&result, a.v.int_val +
  585.                 b.v.int_val);
  586.         break;
  587.     case CMPLX:
  588.         (void) Gcomplex(&result, a.v.int_val +
  589.                 b.v.cmplx_val.real,
  590.                 b.v.cmplx_val.imag);
  591.         break;
  592.         BAD_DEFAULT
  593.     }
  594.     break;
  595.     case CMPLX:
  596.     switch (b.type) {
  597.     case INTGR:
  598.         (void) Gcomplex(&result, b.v.int_val +
  599.                 a.v.cmplx_val.real,
  600.                 a.v.cmplx_val.imag);
  601.         break;
  602.     case CMPLX:
  603.         (void) Gcomplex(&result, a.v.cmplx_val.real +
  604.                 b.v.cmplx_val.real,
  605.                 a.v.cmplx_val.imag +
  606.                 b.v.cmplx_val.imag);
  607.         break;
  608.         BAD_DEFAULT
  609.     }
  610.     break;
  611.     BAD_DEFAULT
  612.     }
  613.     push(&result);
  614. }
  615.  
  616.  
  617. void f_minus()
  618. {
  619.     struct value a, b, result;
  620.     (void) pop(&b);
  621.     (void) pop(&a);        /* now do a - b */
  622.     switch (a.type) {
  623.     case INTGR:
  624.     switch (b.type) {
  625.     case INTGR:
  626.         (void) Ginteger(&result, a.v.int_val -
  627.                 b.v.int_val);
  628.         break;
  629.     case CMPLX:
  630.         (void) Gcomplex(&result, a.v.int_val -
  631.                 b.v.cmplx_val.real,
  632.                 -b.v.cmplx_val.imag);
  633.         break;
  634.         BAD_DEFAULT
  635.     }
  636.     break;
  637.     case CMPLX:
  638.     switch (b.type) {
  639.     case INTGR:
  640.         (void) Gcomplex(&result, a.v.cmplx_val.real -
  641.                 b.v.int_val,
  642.                 a.v.cmplx_val.imag);
  643.         break;
  644.     case CMPLX:
  645.         (void) Gcomplex(&result, a.v.cmplx_val.real -
  646.                 b.v.cmplx_val.real,
  647.                 a.v.cmplx_val.imag -
  648.                 b.v.cmplx_val.imag);
  649.         break;
  650.         BAD_DEFAULT
  651.     }
  652.     break;
  653.     BAD_DEFAULT
  654.     }
  655.     push(&result);
  656. }
  657.  
  658.  
  659. void f_mult()
  660. {
  661.     struct value a, b, result;
  662.     (void) pop(&b);
  663.     (void) pop(&a);        /* now do a*b */
  664.  
  665.     switch (a.type) {
  666.     case INTGR:
  667.     switch (b.type) {
  668.     case INTGR:
  669.         (void) Ginteger(&result, a.v.int_val *
  670.                 b.v.int_val);
  671.         break;
  672.     case CMPLX:
  673.         (void) Gcomplex(&result, a.v.int_val *
  674.                 b.v.cmplx_val.real,
  675.                 a.v.int_val *
  676.                 b.v.cmplx_val.imag);
  677.         break;
  678.         BAD_DEFAULT
  679.     }
  680.     break;
  681.     case CMPLX:
  682.     switch (b.type) {
  683.     case INTGR:
  684.         (void) Gcomplex(&result, b.v.int_val *
  685.                 a.v.cmplx_val.real,
  686.                 b.v.int_val *
  687.                 a.v.cmplx_val.imag);
  688.         break;
  689.     case CMPLX:
  690.         (void) Gcomplex(&result, a.v.cmplx_val.real *
  691.                 b.v.cmplx_val.real -
  692.                 a.v.cmplx_val.imag *
  693.                 b.v.cmplx_val.imag,
  694.                 a.v.cmplx_val.real *
  695.                 b.v.cmplx_val.imag +
  696.                 a.v.cmplx_val.imag *
  697.                 b.v.cmplx_val.real);
  698.         break;
  699.         BAD_DEFAULT
  700.     }
  701.     break;
  702.     BAD_DEFAULT
  703.     }
  704.     push(&result);
  705. }
  706.  
  707.  
  708. void f_div()
  709. {
  710.     struct value a, b, result;
  711.     register double square;
  712.     (void) pop(&b);
  713.     (void) pop(&a);        /* now do a/b */
  714.  
  715.     switch (a.type) {
  716.     case INTGR:
  717.     switch (b.type) {
  718.     case INTGR:
  719.         if (b.v.int_val)
  720.         (void) Ginteger(&result, a.v.int_val /
  721.                 b.v.int_val);
  722.         else {
  723.         (void) Ginteger(&result, 0);
  724.         undefined = TRUE;
  725.         }
  726.         break;
  727.     case CMPLX:
  728.         square = b.v.cmplx_val.real *
  729.         b.v.cmplx_val.real +
  730.         b.v.cmplx_val.imag *
  731.         b.v.cmplx_val.imag;
  732.         if (square)
  733.         (void) Gcomplex(&result, a.v.int_val *
  734.                 b.v.cmplx_val.real / square,
  735.                 -a.v.int_val *
  736.                 b.v.cmplx_val.imag / square);
  737.         else {
  738.         (void) Gcomplex(&result, 0.0, 0.0);
  739.         undefined = TRUE;
  740.         }
  741.         break;
  742.         BAD_DEFAULT
  743.     }
  744.     break;
  745.     case CMPLX:
  746.     switch (b.type) {
  747.     case INTGR:
  748.         if (b.v.int_val)
  749.         (void) Gcomplex(&result, a.v.cmplx_val.real /
  750.                 b.v.int_val,
  751.                 a.v.cmplx_val.imag /
  752.                 b.v.int_val);
  753.         else {
  754.         (void) Gcomplex(&result, 0.0, 0.0);
  755.         undefined = TRUE;
  756.         }
  757.         break;
  758.     case CMPLX:
  759.         square = b.v.cmplx_val.real *
  760.         b.v.cmplx_val.real +
  761.         b.v.cmplx_val.imag *
  762.         b.v.cmplx_val.imag;
  763.         if (square)
  764.         (void) Gcomplex(&result, (a.v.cmplx_val.real *
  765.                       b.v.cmplx_val.real +
  766.                       a.v.cmplx_val.imag *
  767.                       b.v.cmplx_val.imag) / square,
  768.                 (a.v.cmplx_val.imag *
  769.                  b.v.cmplx_val.real -
  770.                  a.v.cmplx_val.real *
  771.                  b.v.cmplx_val.imag) /
  772.                 square);
  773.         else {
  774.         (void) Gcomplex(&result, 0.0, 0.0);
  775.         undefined = TRUE;
  776.         }
  777.         break;
  778.         BAD_DEFAULT
  779.     }
  780.     break;
  781.     BAD_DEFAULT
  782.     }
  783.     push(&result);
  784. }
  785.  
  786.  
  787. void f_mod()
  788. {
  789.     struct value a, b;
  790.     (void) pop(&b);
  791.     (void) pop(&a);        /* now do a%b */
  792.  
  793.     if (a.type != INTGR || b.type != INTGR)
  794.     int_error("can only mod ints", NO_CARET);
  795.     if (b.v.int_val)
  796.     push(Ginteger(&a, a.v.int_val % b.v.int_val));
  797.     else {
  798.     push(Ginteger(&a, 0));
  799.     undefined = TRUE;
  800.     }
  801. }
  802.  
  803.  
  804. void f_power()
  805. {
  806.     struct value a, b, result;
  807.     register int i, t, count;
  808.     register double mag, ang;
  809.     (void) pop(&b);
  810.     (void) pop(&a);        /* now find a**b */
  811.  
  812.     switch (a.type) {
  813.     case INTGR:
  814.     switch (b.type) {
  815.     case INTGR:
  816.         count = abs(b.v.int_val);
  817.         t = 1;
  818.         /* this ought to use bit-masks and squares, etc */
  819.         for (i = 0; i < count; i++)
  820.         t *= a.v.int_val;
  821.         if (b.v.int_val >= 0)
  822.         (void) Ginteger(&result, t);
  823.         else if (t != 0)
  824.         (void) Gcomplex(&result, 1.0 / t, 0.0);
  825.         else {
  826.         undefined = TRUE;
  827.         (void) Gcomplex(&result, 0.0, 0.0);
  828.         }
  829.         break;
  830.     case CMPLX:
  831.         if (a.v.int_val == 0) {
  832.         if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
  833.             undefined = TRUE;
  834.         }
  835.         /* return 1.0 for 0**0 */
  836.         Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
  837.         } else {
  838.         mag =
  839.             pow(magnitude(&a), fabs(b.v.cmplx_val.real));
  840.         if (b.v.cmplx_val.real < 0.0) {
  841.             if (mag != 0.0)
  842.             mag = 1.0 / mag;
  843.             else
  844.             undefined = TRUE;
  845.         }
  846.         mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
  847.         ang = b.v.cmplx_val.real * angle(&a) +
  848.             b.v.cmplx_val.imag * log(magnitude(&a));
  849.         (void) Gcomplex(&result, mag * cos(ang),
  850.                 mag * sin(ang));
  851.         }
  852.         break;
  853.         BAD_DEFAULT
  854.     }
  855.     break;
  856.     case CMPLX:
  857.     switch (b.type) {
  858.     case INTGR:
  859.         if (a.v.cmplx_val.imag == 0.0) {
  860.         mag = pow(a.v.cmplx_val.real, (double) abs(b.v.int_val));
  861.         if (b.v.int_val < 0) {
  862.             if (mag != 0.0)
  863.             mag = 1.0 / mag;
  864.             else
  865.             undefined = TRUE;
  866.         }
  867.         (void) Gcomplex(&result, mag, 0.0);
  868.         } else {
  869.         /* not so good, but...! */
  870.         mag = pow(magnitude(&a), (double) abs(b.v.int_val));
  871.         if (b.v.int_val < 0) {
  872.             if (mag != 0.0)
  873.             mag = 1.0 / mag;
  874.             else
  875.             undefined = TRUE;
  876.         }
  877.         ang = angle(&a) * b.v.int_val;
  878.         (void) Gcomplex(&result, mag * cos(ang),
  879.                 mag * sin(ang));
  880.         }
  881.         break;
  882.     case CMPLX:
  883.         if (a.v.cmplx_val.real == 0 && a.v.cmplx_val.imag == 0) {
  884.         if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
  885.             undefined = TRUE;
  886.         }
  887.         /* return 1.0 for 0**0 */
  888.         Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
  889.         } else {
  890.         mag = pow(magnitude(&a), fabs(b.v.cmplx_val.real));
  891.         if (b.v.cmplx_val.real < 0.0) {
  892.             if (mag != 0.0)
  893.             mag = 1.0 / mag;
  894.             else
  895.             undefined = TRUE;
  896.         }
  897.         mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
  898.         ang = b.v.cmplx_val.real * angle(&a) +
  899.             b.v.cmplx_val.imag * log(magnitude(&a));
  900.         (void) Gcomplex(&result, mag * cos(ang),
  901.                 mag * sin(ang));
  902.         }
  903.         break;
  904.         BAD_DEFAULT
  905.     }
  906.     break;
  907.     BAD_DEFAULT
  908.     }
  909.     push(&result);
  910. }
  911.  
  912.  
  913. void f_factorial()
  914. {
  915.     struct value a;
  916.     register int i;
  917.     register double val = 0.0;
  918.  
  919.     (void) pop(&a);        /* find a! (factorial) */
  920.  
  921.     switch (a.type) {
  922.     case INTGR:
  923.     val = 1.0;
  924.     for (i = a.v.int_val; i > 1; i--)    /*fpe's should catch overflows */
  925.         val *= i;
  926.     break;
  927.     default:
  928.     int_error("factorial (!) argument must be an integer", NO_CARET);
  929.     return;            /* avoid gcc -Wall warning about val */
  930.     }
  931.  
  932.     push(Gcomplex(&a, val, 0.0));
  933.  
  934. }
  935.  
  936.  
  937. int f_jump(x)
  938. union argument *x;
  939. {
  940.     return (x->j_arg);
  941. }
  942.  
  943.  
  944. int f_jumpz(x)
  945. union argument *x;
  946. {
  947.     struct value a;
  948.     int_check(&top_of_stack);
  949.     if (top_of_stack.v.int_val) {    /* non-zero */
  950.     (void) pop(&a);
  951.     return 1;        /* no jump */
  952.     } else
  953.     return (x->j_arg);    /* leave the argument on TOS */
  954. }
  955.  
  956.  
  957. int f_jumpnz(x)
  958. union argument *x;
  959. {
  960.     struct value a;
  961.     int_check(&top_of_stack);
  962.     if (top_of_stack.v.int_val)    /* non-zero */
  963.     return (x->j_arg);    /* leave the argument on TOS */
  964.     else {
  965.     (void) pop(&a);
  966.     return 1;        /* no jump */
  967.     }
  968. }
  969.  
  970.  
  971. int f_jtern(x)
  972. union argument *x;
  973. {
  974.     struct value a;
  975.  
  976.     int_check(pop(&a));
  977.     if (a.v.int_val)
  978.     return (1);        /* no jump; fall through to TRUE code */
  979.     else
  980.     return (x->j_arg);    /* go jump to FALSE code */
  981. }
  982.